• Home
 · 
• String Manipulation
 · 
• Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

Rate Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'MaxChars argument is the length of the displayable path name to return
'ShrinkChar optional argument is the character to use for shortened version ("." is default)
Public Function ShrinkFileName(ByVal NameToShrink As String, _
    ByVal MaxChars As Integer, Optional ByVal ShrinkChar As String) As String
    
    Dim HideChar As String, szFileName As String
    Dim szDir() As String
    Dim nDirs As Integer, nDir1 As Integer, nDir2 As Integer, nDir3 As Integer, nDir4 As Integer
    Dim iCount As Integer
    
    If Len(NameToShrink) < MaxChars Then
        'No change needed
        ShrinkFileName = NameToShrink
        Exit Function
    End If
    
    'Set Hide Character
    If Len(ShrinkChar) > 0 Then
        HideChar = Left(ShrinkChar, 1) & _
            Left(ShrinkChar, 1) & Left(ShrinkChar, 1)
    Else
        HideChar = "." & "." & "."
    End If

    'Split the file name
    szDir() = Split(NameToShrink, "\")
    
    nDirs = UBound(szDir)
    If nDirs < 1 Then
        'FileName can't be shrunk well, just
        'chop off beginning characters to fit
        ShrinkFileName = Right(NameToShrink, MaxChars)
        Exit Function
    End If
    
    'Re-add the "\"s
    For iCount = 1 To nDirs
        szDir(iCount) = "\" & szDir(iCount)
    Next iCount
        
    If Len(szDir(nDirs)) >= MaxChars Or Len(szDir(0)) >= MaxChars Then
        'FileName can't be shrunk well, just
        'chop off the end of the file name
        'to fit.
        ShrinkFileName = Left(szDir(nDirs), MaxChars)
        Exit Function
    End If
    
    'Start the shrunken FileName
    ShrinkFileName = szDir(0)
    
    'Get Section lengths
    nDir1 = Len(szDir(0))           'Drive Letter
    nDir2 = Len(szDir(1))           'First Directory or File Name
    szFileName = szDir(1)
    If nDirs > 1 Then
        nDir3 = Len(szDir(2))       'Second Directory of File Name
        szFileName = szDir(2)
    Else
        nDir3 = 0
    End If
    If nDirs > 2 Then
        nDir4 = Len(szDir(nDirs))   'File Name
        szFileName = szDir(nDirs)
    Else
        nDir4 = 0
    End If
    
    'Worst case scenario (of remaining)
    If nDir1 + Len(szFileName) + Len(HideChar) > MaxChars Then
        ShrinkFileName = szFileName
        Exit Function
    End If
    
    'Next best
    ShrinkFileName = ShrinkFileName & HideChar & szFileName
    If Len(ShrinkFileName) + nDir2 >= MaxChars Or nDir2 < 1 Then
        Exit Function
    Else
        ShrinkFileName = szDir(0) & szDir(1) & HideChar & szFileName
    End If
    
    'Next best
    If Len(ShrinkFileName) + nDir3 >= MaxChars Or nDir3 < 1 Then
        Exit Function
    Else
        ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & HideChar & szFileName
    End If
    
    'Best case scenario
    If Len(ShrinkFileName) + nDir4 <= MaxChars Then
        ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & szDir(3) & HideChar & szFileName
    End If
            
End Function